home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / clx.lha / clx / debug / debug.l next >
Lisp/Scheme  |  1988-09-12  |  2KB  |  75 lines
  1. ;;; -*- Mode:Lisp; Package:XLIB; Syntax:COMMON-LISP; Base:10; Lowercase:YES; Patch-file:T -*-
  2.  
  3. ;;; CLX debugging code
  4.  
  5. ;;;
  6. ;;;             TEXAS INSTRUMENTS INCORPORATED
  7. ;;;                  P.O. BOX 2909
  8. ;;;                   AUSTIN, TEXAS 78769
  9. ;;;
  10. ;;; Copyright (C) 1987 Texas Instruments Incorporated.
  11. ;;;
  12. ;;; Permission is granted to any individual or institution to use, copy, modify,
  13. ;;; and distribute this software, provided that this complete copyright and
  14. ;;; permission notice is maintained, intact, in all copies and supporting
  15. ;;; documentation.
  16. ;;;
  17. ;;; Texas Instruments Incorporated provides this software "as is" without
  18. ;;; express or implied warranty.
  19. ;;;
  20.  
  21. ;;; Created 04/09/87 14:30:41 by LaMott G. OREN
  22.  
  23. (EXPORT '(display-listen
  24.       readflush
  25.       check-buffer
  26.       check-finish
  27.       check-force
  28.       clear-next))
  29.  
  30. (defun display-listen (display)
  31.   (listen (display-input-stream display)))
  32.  
  33. (defun readflush (display)
  34.   ;; Flushes Display's input stream, returning what was there
  35.   (let ((stream (display-input-stream display)))
  36.     (loop while (listen stream) collect (read-byte stream))))
  37.  
  38. ;;-----------------------------------------------------------------------------
  39. ;; The following are useful display-after functions
  40.  
  41. (defun check-buffer (display)
  42.   ;; Ensure the output buffer in display is correct
  43.   (with-buffer-output (display :length :none :sizes (8 16))
  44.     (do* ((i 0 (+ i length))
  45.       request
  46.       length)
  47.      ((>= i buffer-boffset)
  48.       (unless (= i buffer-boffset)
  49.         (si:fsignal "Buffer size ~d  Requests end at ~d" buffer-boffset i)))
  50.       (LET ((buffer-boffset 0)
  51.         #+clx-overlapping-arrays
  52.         (buffer-woffset 0))
  53.     (setq request (card8-get i))
  54.     (setq length (* 4 (card16-get (+ i 2)))))
  55.       (when (zerop request)
  56.     (si:fsignal "Zero request in buffer")
  57.     (return nil))
  58.       (when (zerop length)
  59.     (si:fsignal "Zero length in buffer")
  60.     (return nil)))))
  61.  
  62. (defun check-finish (display)
  63.   (check-buffer display)
  64.   (display-finish-output display))
  65.  
  66. (defun check-force (display)
  67.   (check-buffer display)
  68.   (display-force-output display))
  69.  
  70. (defun clear-next (display)
  71.   ;; Never append requests
  72.   (setf (display-last-request display) nil))
  73.  
  74. ;; End of file
  75.